Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/utils/ted/tedtro2.pas

Pascal/Delphi Source File | 1994-10-02 | 5.3 KB | 197 lines

{
                          Coding & Editing by :
        █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀█ █ █▀▀▀▀▀▀▀ █▀▀▀▀▀▀▀
        █▀▀▀▀▀▀▀ █▀▀▀▀▀▀█ █▀▀▀▀▀█▀ █▀▀▀▀▀▀█ █     █ █ ▀▀▀▀▀▀▀█ █▀▀▀▀▀
        █        █      █ █      █ █      █ █     █ █        █ █
        █        █      █ █      █ █      █ █     █ █        █ █
        █        █      █ █      █ █      █ █     █ █        █ █
        █        █      █ █      █ █      █ █▄▄▄▄▄█ █ ▄▄▄▄▄▄▄█ █▄▄▄▄▄▄▄

        Programmed by Marcin Jaskowiak, aka Paradise, Lublin, Poland,
                          in Turbo Pascal 7.0.

        This is FUQNWARE - if u like it, u must register it by sending
        some money (u tell how much) to ME:) if not - u choose.
        Read TED.DOC 4 more info.

        Snail mail:                      Email:
        Marcin Jaskowiak                 [e-mail]
        Flat 114, 3 Zarnowiecka Str.
        20-630 Lublin
        Poland

                               Presents :
                    TED font editor SCROLLERS PACK 94
                                with :
                             EXAMPLE NR 2
}
PROGRAM TED_INTRO_NR2;
USES DOS,CRT;

CONST
 SEGA000        : WORD = $A000;
VAR
 BITMAP         : ARRAY [1..40,0..319] OF BYTE;
 PALETTE        : ARRAY [0..255,1..3] OF BYTE;
 CHARS          : ARRAY [' '..']'] OF POINTER;
 CHARSDATA      : ARRAY [' '..']',1..3] OF BYTE;
 F              : FILE;
 B,ROW,NR       : BYTE;
 X,Y,I          : INTEGER;
 CH,K           : CHAR;
 TEKST          : STRING;

{───────────────────────────────────────────────────────────────────────────}
PROCEDURE INITVGA; ASSEMBLER; { INITIALIZE VGA CARD MODE 13H }
ASM
 MOV AX,0013H
 INT 10H
END;
{───────────────────────────────────────────────────────────────────────────}
PROCEDURE CLOSEVGA; ASSEMBLER; { CLOSE VGA MODE AND SET TEXT }
ASM
 MOV AX,0003H
 INT 10H
END;
{───────────────────────────────────────────────────────────────────────────}
PROCEDURE VSYNC; ASSEMBLER;
ASM
 MOV DX,03DAH
 @L1: IN AL,DX; TEST AL,8; JNZ @L1;
 @L2: IN AL,DX; TEST AL,8; JZ  @L2;
END;
{───────────────────────────────────────────────────────────────────────────}
PROCEDURE DRAWBITMAP; ASSEMBLER;
ASM
 XOR DI,DI
 MOV ES,SEGA000
 MOV SI,OFFSET BITMAP
 MOV CX,6400
 CLD
 REP MOVSW
END;
{───────────────────────────────────────────────────────────────────────────}
PROCEDURE SCROLLBITMAP(VAR MAP); ASSEMBLER;
ASM
  LDS SI,MAP
  LES DI,MAP
  INC SI
  INC SI
  INC SI
  MOV CX,6400
  REP MOVSW
END;
{───────────────────────────────────────────────────────────────────────────}
PROCEDURE SETCOLOR(NR,R,G,B: BYTE); ASSEMBLER; { SET RGB VAL TO COLOR NR }
ASM
 MOV DX,3C8H
 MOV AL,NR
 OUT DX,AL
 INC DX
 MOV AL,R
 OUT DX,AL
 MOV AL,G
 OUT DX,AL
 MOV AL,B
 OUT DX,AL
END;
{───────────────────────────────────────────────────────────────────────────}
PROCEDURE LOADPAL(NAME: STRING); { LOAD .PAL FILE AND SET PALETTE }
BEGIN
 ASSIGN(F,NAME+'.PAL');
 RESET(F,1);
 BLOCKREAD(F,PALETTE,768);
 CLOSE(F);
 FOR B:=0 TO 255 DO SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
END;
{───────────────────────────────────────────────────────────────────────────}
PROCEDURE LOADTED(NAME: STRING); { LOAD .TED FILE TO MEMORY }
VAR TX,TY: BYTE; CH: CHAR;
BEGIN
 ASSIGN(F,NAME+'.TED');
 RESET(F,1);
 SEEK(F,20);
 WHILE NOT(EOF(F)) DO
 BEGIN
  BLOCKREAD(F,CH,1);
  BLOCKREAD(F,TX,1);
  BLOCKREAD(F,TY,1);
  GETMEM(CHARS[CH],TX*TY);
  CHARSDATA[CH,1]:=TX; CHARSDATA[CH,2]:=TY; CHARSDATA[CH,3]:=1;
  BLOCKREAD(F,CHARS[CH]^,TX*TY);
 END;
 IF CHARSDATA[' ',3]<>1 THEN { IF NOT SPACE " " THEN CREATE IT }
 BEGIN
  TX:=CHARSDATA['A',1];
  TY:=CHARSDATA['A',2];
  GETMEM(CHARS[' '],TX*TY);
  FILLCHAR(CHARS[' ']^,TX*TY,0);
  CHARSDATA[' ',3]:=1;
  CHARSDATA[' ',1]:=TX;
  CHARSDATA[' ',2]:=TY;
 END;
 CLOSE(F);
END;
{───────────────────────────────────────────────────────────────────────────}
PROCEDURE DONETED; { DEALLOCATE FONT MEMORY }
VAR CH: CHAR;
BEGIN
 FOR CH:=' ' TO ']' DO
 BEGIN
  IF CHARSDATA[CH,3]=1 THEN
  BEGIN
   FREEMEM(CHARS[CH],CHARSDATA[CH,1]*CHARSDATA[CH,2]);
   CHARSDATA[CH,3]:=0;
  END;
 END;
END;
{───────────────────────────────────────────────────────────────────────────}
PROCEDURE NEWROW(CH: CHAR; RO: BYTE; POS: INTEGER); { DRAW HORIZ LINE }
VAR TX,TY: INTEGER;
BEGIN
 IF CHARSDATA[CH,3]<>1 THEN EXIT;
 IF RO=CHARSDATA[CH,1]+1 THEN
  FOR TY:=1 TO CHARSDATA[CH,2] DO BITMAP[TY,POS]:=0 { SKIP ONE ROW }
 ELSE
  FOR TY:=1 TO CHARSDATA[CH,2] DO
   BITMAP[TY,POS]:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(TY-1)*CHARSDATA[CH,1]+RO-1];
END;
{───────────────────────────────────────────────────────────────────────────}
PROCEDURE UPDATE; { NEW VALUES ? }
BEGIN
 INC(ROW);
 IF ROW>CHARSDATA[TEKST[NR],1]+1 THEN
 BEGIN
  ROW:=1;
  INC(NR);
  IF NR>LENGTH(TEKST) THEN NR:=1;
 END;
END;
{───────────────────────────────────────────────────────────────────────────}



BEGIN
 INITVGA;
 LOADPAL('FONT000');
 LOADTED('FONT000');

 ROW:=1;
 TEKST:='HMM... THAT IS SIMPLE SCROLLING. AS U SEE....  IT USE FONT000.TED TO PLAY              ';
 NR:=1;

 REPEAT
  SCROLLBITMAP(BITMAP);
  UPDATE;
  NEWROW(TEKST[NR],ROW,317);
  UPDATE;
  NEWROW(TEKST[NR],ROW,318);
  UPDATE;
  NEWROW(TEKST[NR],ROW,319);
  DRAWBITMAP;
  VSYNC;
 UNTIL KEYPRESSED;

 DONETED;
 CLOSEVGA;
END.